home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / PPC source / qpCreate < prev    next >
Text File  |  1998-05-25  |  6KB  |  279 lines
  1. PPC? not
  2. [IF]
  3.  
  4. ¥ First we have to define a number of VALUEs that are used in the
  5. ¥  following files, but before CROSS - we put them here since we're
  6. ¥  about to redefine VALUE.
  7. ¥ Well actually there's no need to any more, but this works...
  8.  
  9. 0    value    theObj            ¥ needed by qClass
  10. 0    value    ^xarea
  11.  
  12. 0    value    loc_addr        ¥ needed by qArgs
  13.  
  14. 0    value    objClass        ¥ a new version of this value - otherwise if we
  15.                             ¥  have an error dump in the code generation, the
  16.                             ¥  plot gets badly lost.
  17.  
  18.  
  19. [THEN]
  20.  
  21.  
  22. (*                ============================
  23.  
  24.   The following probably won't be needed when we're running the code
  25.   generator on the PPC itself.  We redefine a number of words such as
  26.   CREATE to use PPC_HEADER rather than revector the existing HEADER, since
  27.   running on the PPC the 68k version of HEADER won't exist, of course.
  28.   We then redefine VALUE so we can have PPC-style VALUEs from now on.
  29.   We couldn't do it earlier since we need 68k-style values to run
  30.   this code on the 68k.
  31.   
  32.                   ============================
  33. *)
  34.  
  35. : (CREATE)        ¥ ( hndlr-code -- )
  36. [ ppc? ] [if]  header  [else]  ppc_header  [then]
  37.     codeW,  0 codeW,        ¥ store handler code and align
  38.     CDP  0 code,
  39.     DP swap reloc!            ¥ store reloc pointer to data area
  40. ;
  41.  
  42. : (sCREATE)        ¥ ( addr len hndlr-code -- )
  43.     down  [ ppc? ] [if]  sHdr  [else]  ppc_sHdr  [then]
  44.     codeW,  0 codeW,        ¥ store handler code and align
  45.     CDP  0 code,
  46.     DP swap reloc!
  47. ;
  48.  
  49.  
  50. PPC?
  51. [IF]
  52.  
  53. : CREATE
  54.     $ BC04 (create)  ;
  55.  
  56. : sCreate
  57.     $ BC04 (sCreate)  ;
  58.  
  59. : VARIABLE
  60.     align4                        ¥ align in data area
  61.     create  0 ,  ;
  62.  
  63. : CONSTANT                        ¥ these are stored in the code area
  64.     header
  65.     $ BC02 codeW,  0 codeW,        ¥ store handler code and align
  66.     code,  ;                    ¥ then the constant itself
  67.  
  68.  
  69. : VALUE
  70.     align4                        ¥ align in data area
  71.     $ BC03 (create)  ,  ;
  72.  
  73.  
  74. : FCONSTANT
  75.     header
  76.     $ BC26 codeW,
  77.     CDP 7 + $ fffffff8 and  -> CDP
  78.     CDP f!  8 ++> CDP
  79. ;
  80.  
  81. : FVALUE
  82.     align8
  83.     $ BC27 (create)
  84.     DP f!  8 ++> DP
  85. ;
  86.  
  87.  
  88. : OBJPTR
  89.     align4                        ¥ align in data area
  90.     $ BC1F (create)
  91.     nilP ,  0 ,  ;
  92.  
  93. [ELSE]
  94.  
  95. : CREATE
  96.     ppc?
  97.     IF        $ BC04 (create)
  98.     ELSE    create
  99.     THEN
  100. ;
  101.  
  102. : createx    create  ;
  103.  
  104. : sCreate
  105.     $ BC04 (sCreate)  ;
  106.  
  107. : VARIABLE
  108.     ppc?
  109.     IF        align4                ¥ align in data area
  110.             create  0 ,
  111.     ELSE    variable
  112.     THEN
  113. ;
  114.  
  115. : CONSTANT            ¥ these are stored in the code area
  116.     ppc?
  117.     IF        ppc_header
  118.             $ BC02 codeW,  0 codeW,        ¥ store handler code and align
  119.             code,
  120.     ELSE    constant
  121.     THEN
  122. ;
  123.  
  124. : VALUE
  125.     ppc?
  126.     IF        align4                ¥ align in data area
  127.             $ BC03 (create)  ,
  128.     ELSE    value
  129.     THEN
  130. ;
  131.  
  132. : valuex    value  ;
  133.  
  134. [THEN]
  135.  
  136. : OBJPTR
  137.     align4                        ¥ align in data area
  138.     $ BC1F (create)
  139.     nilP ,  0 ,  ;
  140.  
  141.  
  142. ¥ On the PPC, thankfully, <BUILDS can be the same as CREATE!
  143. ¥ If we decide we need PPC <builds...does> in 68k mode, put it here:
  144.  
  145. PPC?
  146. [IF]
  147.  
  148. : <BUILDS    create  0 code,  ;
  149.  
  150.  
  151. : fix_does  { ¥ cfa -- }
  152.     latest name>  -> cfa
  153.     $ BC0C  cfa 2- w!        ¥ change handler code to does_h
  154.     
  155. ¥ now we have to locate the runtime (does) code - this will
  156. ¥  come soon after where we were called from, so we just scan
  157. ¥  forward for the  $ BE00 handler code for the :noname
  158. ¥  definition.  As this isn't a leaf proc, our return addr
  159. ¥  is on the top of the return stack.
  160.  
  161.     r@
  162.     BEGIN
  163.         dup w@ $ BE00 =
  164.     NWHILE
  165.         4+
  166.     REPEAT
  167.     2+  cfa 6 + reloc!        ¥ and put reloc addr of runtime (does)
  168.                             ¥  after the reloc addr of the data code
  169. ;
  170.  
  171. : DOES>
  172.     postpone fix_does    ¥ the CREATE code will finish with fix_does
  173.     " ;"  evaluate        ¥ finish off the CREATE code
  174.     :noname                ¥ start a :noname defn for the DOES> code
  175.     nip                    ¥ don't need xt - leave security marker
  176.                         ¥  for final ; to consume
  177. ;                immediate
  178.  
  179.  
  180. [THEN]
  181.  
  182.  
  183. : VECT
  184.     align4
  185.     $ BC05 (create)
  186.     DP  4 ++> DP
  187.     reloc!  ;
  188.  
  189.  
  190. : SVECT        ¥ system vectors are really only for Mops internal use.
  191.             ¥  they have a default value 4 bytes after the regular one, which
  192.             ¥  gets used if the regular value is zero.
  193.     align4
  194.     $ BC3D (create)
  195.     0 ,                ¥ initial "regular value" is zero
  196.     DP  4 ++> DP
  197.     reloc!
  198. ;
  199.  
  200. (*    Dynamic vectors are "lightweight" vectors in which we don't use a relocatable
  201.     addr but just store the xt to be executed, which allows us to point into
  202.     a module if we know it's safe.  These should never be saved in the dic and used
  203.     after reloading - hence the name "dynamic".  Like system vectors, zero means
  204.     use the default, but the default is always do nothing.
  205. *)
  206.  
  207. : DYNAMICVECT    
  208.     align4
  209.     $ BC3B (create)
  210.     0 ,                ¥ initial value is zero
  211. ;
  212.  
  213.  
  214. PPC?
  215. [IF]
  216.  
  217. ¥ in zBase
  218.  
  219. [ELSE]
  220.  
  221. : (createObj)        ¥ temp, for hand-winding an object while testing.
  222.                         ¥ in data area:
  223.     align4                    ¥ must be aligned
  224.     0 ,                        ¥  reserve space for class pointer
  225.     -2 w,                    ¥  offset to indexed length word (-2 if not
  226.                             ¥    indexed)
  227.     -6 w,                    ¥  offset to start of obj header
  228.                             ¥  (DP is now at start of obj data)
  229.                             
  230.                         ¥ in code area:
  231.     $ BC0B (create)            ¥ create with obj_h handler code, with
  232.                             ¥  reloc ptr to obj data
  233. ;
  234.  
  235.  
  236. (*    For MARKER, we don't use <builds...does> as on the 68k, since
  237.     there's no need to put the marker info in the data area, 'cause
  238.     it's only used during development.  A marker just becomes a
  239.     defn with a special handler code, and we put the associated
  240.     info straight after the header in the code area.
  241.     
  242.     We can't execute the marker in the handler, since at that stage
  243.     we're probably in the execution buffer so resetting CDP wouldn't
  244.     be very sensible.  So we just compile a call to (mrk) which does
  245.     the work, and leave the new CDP in a value for (mrk) to pick up.
  246. *)
  247.  
  248. : MARKER
  249.     crossed?  0EXIT                    ¥ just in case - mustn't monkey with CDP
  250.                                     ¥  before it's set up!!
  251.     CDP
  252.     ppc_header
  253.     $ BC410000 code,                ¥ marker_h handler code, and alignment
  254.                                     ¥ Note - we'll indicate a file mark
  255.                                     ¥  by putting something nonzero in these
  256.                                     ¥  pad bytes
  257.     ( orig-CDP )    displCode,
  258.     DP                displCode,
  259. ;
  260.  
  261.  
  262. 0    value    cdp2use
  263.  
  264. : (mrk)
  265.     cdp2use
  266.     dup displace    -> CDP        4+
  267.         displace    -> DP        4+        
  268.     CDP (forget)                    ¥ fixes CONTEXT and LATEST
  269.     -echo
  270. ;
  271.  
  272. :f marker_h  ( xt -- )
  273.     2+ -> cdp2use
  274.     ['] (mrk)  (comp)
  275. ;f
  276.  
  277. [THEN]
  278.  
  279.